home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt3sp2.arc
/
PIBANSIA.PAS
next >
Wrap
Pascal/Delphi Source File
|
1985-09-09
|
23KB
|
503 lines
(*----------------------------------------------------------------------*)
(* Emulate_ANSI -- Controls VT100 emulation *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Emulate_ANSI( VT100_Allowed : BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Emulate_ANSI *)
(* *)
(* Purpose: Controls ANSI terminal emulation *)
(* *)
(* Calling Sequence: *)
(* *)
(* Emulate_ANSI( VT100_allowed ); *)
(* *)
(* VT100_allowed --- TRUE to interpret private DEC sequences *)
(* *)
(* Remarks: *)
(* *)
(* The ANSI and VT100 emulation are partly based upon TMODEM *)
(* by Paul Meiners and partly upon ISP100 by Tim Krauskopf. *)
(* *)
(* VT100/ANSI commands are interpreted directly by these *)
(* routines -- the ANSI.SYS driver is not required and should *)
(* probably not be used, as it will result in an unnecessary *)
(* performance degradation. *)
(* *)
(* This is by no means a complete VT100 or Ansi emulation. It *)
(* works well enough so that the full-screen editors EDT under *)
(* VAX/VMS and FSE under CDC/NOS will perform properly. That was *)
(* my primary intention. You may want to add code to emulate *)
(* other VT100/VT102/VT103/VT131 features not found here. If you *)
(* do, please send me back a copy so that I can add your upgrades *)
(* to future releases of PibTerm. *)
(* *)
(* Also note that this emulation assumes 25 lines on the screen. *)
(* The VT100 only has 24. *)
(* *)
(* The following variables are of central interest in the *)
(* emulation: *)
(* *)
(* Escape_Mode --- TRUE if processing escape sequence *)
(* Escape_Type --- Type of escape sequence being processed *)
(* Escape_Number --- Number of numeric parameters in escape *)
(* sequence *)
(* Escape_Register --- array of numeric parameters in escape *)
(* sequence *)
(* Escape_Str --- stores string of escape text; used to *)
(* gather up a musical score for BBS Ansi. *)
(* *)
(*----------------------------------------------------------------------*)
CONST
ON = TRUE (* Convenient synonym for switches *);
OFF = FALSE (* Likewise *);
VAR
Comm_Ch : CHAR (* Character read from comm port *);
Kbd_Ch : CHAR (* Character read from keyboard *);
VT100_Graphics_Mode : BOOLEAN (* TRUE if VT100 graphics mode on *);
VT100_KeyPad : BOOLEAN (* TRUE if alternate keypad in use *);
Origin_Mode : BOOLEAN (* TRUE for region origin mode *);
Done : BOOLEAN (* TRUE to stop PIBTERM *);
B : BOOLEAN (* General purpose flag *);
Graph_Ch : BYTE (* Graphics character *);
Itab : BYTE (* Tab stop *);
Tabcol : BYTE (* Tab column *);
Curcol : BYTE (* Current column in display *);
Auto_Print_Mode : BOOLEAN (* IF auto print mode in effect *);
Printer_Ctrl_Mode : BOOLEAN (* IF printer controller mode on *);
Print_Line : STRING[80] (* Line to print if print mode on *);
Reg_Val : INTEGER (* General utility register value *);
Escape_Mode : BOOLEAN (* If processing escape sequence *);
Escape_Number : INTEGER (* # of numeric parms in esc seq. *);
(* Holds numeric parms in esc seq *)
Escape_Register : ARRAY[1..50] OF BYTE;
Escape_Str : AnyStr (* Collects string arg in esc seq *);
Escape_Type : CHAR (* Type of escape seq. being done *);
(* Remember cursor/attributes *)
Save_Row_Position : INTEGER;
Save_Col_Position : INTEGER;
Save_BG_Color : INTEGER;
Save_FG_Color : INTEGER;
(* Save current scrolling region *)
Top_Scroll : INTEGER;
Bottom_Scroll : INTEGER;
Ansi_ForeGround_Color : INTEGER (* Global foreground color here *);
Ansi_BackGround_Color : INTEGER (* Global background color here *);
Ansi_Underline_Color : INTEGER (* Color for underlines *);
Ansi_Bold_Color : INTEGER (* Color for bolding *);
FG : INTEGER (* Foreground color *);
BG : INTEGER (* Background color *);
White_Shade : INTEGER (* Current shade of white *);
Save_Global_FG : INTEGER (* Save global foreground color *);
Save_Global_BG : INTEGER (* Save global background color *);
Save_FG : INTEGER (* Save foreground color *);
Save_BG : INTEGER (* Save background color *);
Double_Width_Mode : BOOLEAN (* Double width characters *);
CONST (* Special VT100 graphics chars *)
Graphics_Chars: ARRAY[ 95 .. 126 ] Of BYTE
= ( 32, 4, 177, 9, 12, 13, 10, 248, 241,
10, 10, 217, 191, 218, 192, 197, 196, 196,
196, 196, 95, 195, 180, 193, 194, 179, 243,
242, 227, 168, 156, 250 );
(* VT100 tabs stops *)
Number_VT100_Tabs = 16;
VT100_Tabs: ARRAY[ 1 .. Number_VT100_Tabs ] Of BYTE
= ( 9, 17, 25, 33, 41, 49, 57, 65, 73, 74, 75, 76, 77,
78, 79, 80 );
(* ------------------------------------------------------------------------ *)
(* PibPlaySet --- Set up to play music *)
(* PibPlay --- Play Music through Speaker *)
(* ------------------------------------------------------------------------ *)
PROCEDURE PibPlaySet;
(* ------------------------------------------------------------------------ *)
(* *)
(* Procedure: PibPlaySet *)
(* *)
(* Purpose: Sets up to play music though PC's speaker *)
(* *)
(* Calling Sequence: *)
(* *)
(* PibPlaySet; *)
(* *)
(* Calls: None *)
(* *)
(* ------------------------------------------------------------------------ *)
BEGIN (* PibPlaySet *)
(* Default Octave *)
Note_Octave := 4;
(* Default sustain is semi-legato *)
Note_Fraction := 0.875;
(* Note is quarter note by default *)
Note_Length := 0.25;
(* Moderato pace by default *)
Note_Quarter := 500.0;
END (* PibPlaySet *);
PROCEDURE PibPlay( S : AnyStr );
(* ------------------------------------------------------------------------ *)
(* *)
(* Procedure: PibPlay *)
(* *)
(* Purpose: Play music though PC's speaker *)
(* *)
(* Calling Sequence: *)
(* *)
(* PibPlay( Music_String : AnyStr ); *)
(* *)
(* Music_String --- The string containing the encoded music to be *)
(* played. The format is the same as that of the *)
(* MicroSoft Basic PLAY Statement. The string *)
(* must be <= 254 characters in length. *)
(* *)
(* Calls: Sound *)
(* GetInt (Internal) *)
(* *)
(* Remarks: The characters accepted by this routine are: *)
(* *)
(* A - G Musical Notes *)
(* # or + Following A - G note, indicates sharp *)
(* - Following A - G note, indicates flat *)
(* < Move down one octave *)
(* > Move up one octave *)
(* . Dot previous note (extend note duration by 3/2) *)
(* MN Normal duration (7/8 of interval between notes) *)
(* MS Staccato duration *)
(* ML Legato duration *)
(* Ln Length of note (n=1-64; 1=whole note, *)
(* 4=quarter note, etc.) *)
(* Pn Pause length (same n values as Ln above) *)
(* Tn Tempo, n=notes/minute (n=32-255, default n=120) *)
(* On Octave number (n=0-6, default n=4) *)
(* Nn Play note number n (n=0-84) *)
(* *)
(* The following two commands are IGNORED by PibPlay: *)
(* *)
(* MF Complete note before continuing *)
(* MB Another process may begin before speaker is *)
(* finished playing note *)
(* *)
(* IMPORTANT --- PibPlaySet MUST have been called at least once before *)
(* this routine is called. *)
(* *)
(* ------------------------------------------------------------------------ *)
CONST
(* Offsets in octave of natural notes *)
Note_Offset : ARRAY[ 'A'..'G' ] OF INTEGER
= ( 9, 11, 0, 2, 4, 5, 7 );
(* Frequencies for 7 octaves *)
Note_Freqs: ARRAY[ 0 .. 84 ] OF INTEGER
=
(*
C C# D D# E F F# G G# A A# B
*)
( 0,
65, 69, 73, 78, 82, 87, 92, 98, 104, 110, 116, 123,
131, 139, 147, 156, 165, 175, 185, 196, 208, 220, 233, 247,
262, 278, 294, 312, 330, 350, 370, 392, 416, 440, 466, 494,
524, 556, 588, 624, 660, 700, 740, 784, 832, 880, 932, 988,
1048, 1112, 1176, 1248, 1320, 1400, 1480, 1568, 1664, 1760, 1864, 1976,
2096, 2224, 2352, 2496, 2640, 2800, 2960, 3136, 3328, 3520, 3728, 3952,
4192, 4448, 4704, 4992, 5280, 5600, 5920, 6272, 6656, 7040, 7456, 7904 );
Quarter_Note = 0.25; (* Length of a quarter note *)
VAR
(* Frequency of note to be played *)
Play_Freq : INTEGER;
(* Duration to sound note *)
Play_Duration : INTEGER;
(* Duration of rest after a note *)
Rest_Duration : INTEGER;
(* Offset in Music string *)
I : INTEGER;
(* Current character in music string *)
C : CHAR;
(* Note Frequencies *)
Freq : ARRAY[ 0 .. 6 , 0 .. 11 ] OF INTEGER ABSOLUTE Note_Freqs;
N : INTEGER;
XN : REAL;
K : INTEGER;
(* ------------------------------------------------------------------------ *)
FUNCTION GetInt : INTEGER;
(* --- Get integer from music string --- *)
VAR
N : INTEGER;
BEGIN (* GetInt *)
N := 0;
WHILE( S[I] In ['0'..'9'] ) DO
BEGIN
N := N * 10 + ORD( S[I] ) - ORD('0');
I := I + 1;
END;
I := I - 1;
GetInt := N;
END (* GetInt *);
(* ------------------------------------------------------------------------ *)
BEGIN (* PibPlay *)
(* Append blank to end of music string *)
S := S + ' ';
(* Point to first character in music *)
I := 1;
(* BEGIN loop over music string *)
WHILE( I < LENGTH( S ) ) DO
BEGIN (* Interpret Music *)
(* Get next character in music string *)
C := UpCase(S[I]);
(* Interpret it *)
CASE C OF
'A'..'G' : BEGIN (* A Note *)
N := Note_Offset[ C ];
Play_Freq := Freq[ Note_Octave , N ];
XN := Note_Quarter * ( Note_Length / Quarter_Note );
Play_Duration := TRUNC( XN * Note_Fraction );
Rest_Duration := TRUNC( XN * ( 1.0 - Note_Fraction ) );
(* Check for sharp/flat *)
IF S[I+1] In ['#','+','-' ] THEN
BEGIN
I := I + 1;
CASE S[I] OF
'#' : Play_Freq :=
Freq[ Note_Octave , N + 1 ];
'+' : Play_Freq :=
Freq[ Note_Octave , N + 1 ];
'-' : Play_Freq :=
Freq[ Note_Octave , N - 1 ];
ELSE ;
END (* Case *);
END;
(* Check for note length *)
IF S[I+1] In ['0'..'9'] THEN
BEGIN
I := I + 1;
N := GetInt;
XN := ( 1.0 / N ) / Quarter_Note;
Play_Duration :=
TRUNC( Note_Fraction * Note_Quarter * XN );
Rest_Duration :=
TRUNC( ( 1.0 - Note_Fraction ) *
Xn * Note_Quarter );
END;
(* Check for dotting *)
IF S[I+1] = '.' THEN
BEGIN
XN := 1.0;
WHILE( S[I+1] = '.' ) DO
BEGIN
XN := XN * 1.5;
I := I + 1;
END;
Play_Duration :=
TRUNC( Play_Duration * XN );
END;
(* Play the note *)
Sound( Play_Freq );
Delay( Play_Duration );
NoSound;
Delay( Rest_Duration );
END (* A Note *);
'M' : BEGIN (* 'M' Commands *)
I := I + 1;
C := S[I];
Case C Of
'F' : ;
'B' : ;
'N' : Note_Fraction := 0.875;
'L' : Note_Fraction := 1.000;
'S' : Note_Fraction := 0.750;
ELSE ;
END (* Case *);
END (* 'M' Commands *);
'O' : BEGIN (* Set Octave *)
I := I + 1;
N := ORD( S[I] ) - ORD('0');
IF ( N < 0 ) OR ( N > 6 ) THEN N := 4;
Note_Octave := N;
END (* Set Octave *);
'<' : BEGIN (* Drop an octave *)
IF Note_Octave > 0 THEN
Note_Octave := Note_Octave - 1;
END (* Drop an octave *);
'>' : BEGIN (* Ascend an octave *)
IF Note_Octave < 6 THEN
Note_Octave := Note_Octave + 1;
END (* Ascend an octave *);
'N' : BEGIN (* Play Note N *)
I := I + 1;
N := GetInt;
IF ( N > 0 ) AND ( N <= 84 ) THEN
BEGIN
Play_Freq := Note_Freqs[ N ];
XN := Note_Quarter *
( Note_Length / Quarter_Note );
Play_Duration := TRUNC( XN * Note_Fraction );
Rest_Duration := TRUNC( XN * ( 1.0 - Note_Fraction ) );
END
ELSE IF ( N = 0 ) THEN
BEGIN
Play_Freq := 0;
Play_Duration := 0;
Rest_Duration :=
TRUNC( Note_Fraction * Note_Quarter *
( Note_Length / Quarter_Note ) );
END;
Sound( Play_Freq );
Delay( Play_Duration );
NoSound;
Delay( Rest_Duration );
END (* Play Note N *);
'L' : BEGIN (* Set Length of Notes *)
I := I + 1;
N := GetInt;
IF N > 0 THEN Note_Length := 1.0 / N;
END (* Set Length of Notes *);
'T' : BEGIN (* # of quarter notes in a minute *)
I := I + 1;
N := GetInt;
Note_Quarter := ( 1092.0 / 18.2 / N ) * 1000.0;
END (* # of quarter notes in a minute *);
'P' : BEGIN (* Pause *)
I := I + 1;
N := GetInt;
IF ( N < 1 ) THEN N := 1
ELSE IF ( N > 64 ) THEN N := 64;
Play_Freq := 0;
Play_Duration := 0;
Rest_Duration :=
TRUNC( ( ( 1.0 / N ) / Quarter_Note )
* Note_Quarter );
Sound( Play_Freq );
Delay( Play_Duration );
NoSound;
Delay( Rest_Duration );
END (* Pause *);
ELSE
(* Ignore other stuff *);
END (* Case *);
I := I + 1;
END (* Interpret Music *);
(* Make sure sound turned off when through *)
NoSound;
END (* PibPlay *);
